perm filename GENPAT[PAT,LMM] blob
sn#062956 filedate 1973-09-20 generic text, type T, neo UTF8
(FILECREATED "20-SEP-73 14:34:56" GENPAT)
(DEFINEQ
(DIFF
[LAMBDA (X Y)
(FOR A IN X JOIN (AND (NOT (FMEMB A Y))
(LIST A])
(LISTOFPATTERNELTS
[LAMBDA (L)
(OR L=NIL L:(&@PATTERNELT ! &@LISTOFPATTERNELTS])
(PATTERNELT
[LAMBDA (X)
(OR (X:(! '&))
(X:(! &@NUMBERP))
(X:(! &@STRINGP))
(X:(! '$))
(X:(! '--))
(X:(! NIL))
(X:(! T))
(X:('$PACKED$ ! &@NLISTP))
(X:('@ &@GETD ! &@PATTERNELT))
(X:('<- &@LITATOM ! &@PATTERNELT))
(X:('← &@LITATOM ! &@PATTERNELT))
(X:('→ &@EXPRESSION ! &@PATTERNELT))
(X:('-> &@EXPRESSION ! &@PATTERNELT))
(X:('= ! &@EXPRESSION))
(X:('== ! &@EXPRESSION))
(X:('' ! &))
(X:('* ! &@PATTERNELT))
(X:('SUBPAT ! &@LISTOFPATTERNELTS))
(X:('! ! &@PATTERNELT))
(X:('*GLITCH & ! &@PATTERNELT])
(ELTPATELT'
[LAMBDA NIL
(ORR1 (PACKRAT (ORR (QUOTE =)
(QUOTE ==))
(EXPRESSION))
(PACKRAT (QUOTE ')
(EXPRESSION))
(LIST (ORR1 (QUOTE &)
(QUOTE $1)))
(LIST (QUOTE *))
(LIST (PAT'))
(LIST (ORR1 (VAR)
(NUMBER)
T NIL "STRING"))
[PACKRAT2 (APPEND (ELTPATELT')
(LIST (QUOTE @)
(FNNAME]
[PACKRAT2 (APPEND (ELTPATELT')
(LIST (QUOTE ←)
(EXPRESSION]
(PACKRAT2 (CONS (VAR)
(CONS (QUOTE ←)
(ELTPATELT'])
(PATELT'
[LAMBDA NIL
(ORR1 (ELTPATELT')
(LIST (ORR1 (QUOTE $)
(QUOTE $$)
(QUOTE --)))
(ORR1 [PACKRAT2 (CONS (VAR)
(CONS (QUOTE ←)
(PATELT']
[PACKRAT2 (APPEND (PATELT')
(LIST (QUOTE ←)
(EXPRESSION]
[PACKRAT2 (CONS (QUOTE !)
(CONS (VAR)
(CONS (QUOTE ←)
(PATELT']
[PACKRAT2 (APPEND (PATELT')
(LIST (QUOTE @)
(FNNAME]
(PACKRAT (QUOTE $)
(ORR (NUMBER)
(VAR)))
(PACKRAT (QUOTE !←)
(EXPRESSION])
(PAT'
[LAMBDA NIL
(FOR X FROM 1 TO (RAND 1 5) JOIN (PATELT'])
(DE
[NLAMBDA L
(DEFINE (LIST L])
(ERSET
[LAMBDA (X)
(PROG ((STACK (CDR STACK)))
(ERRORSET X])
(NUMBEREXPRESSION
[LAMBDA NIL
(ORR (VAR)
(LIST (QUOTE IPLUS)
(VAR)
(VAR])
(STRING
[LAMBDA NIL
(MKSTRING (VAR])
(PACKRAT2
[LAMBDA (L)
(APPLY (QUOTE PACKRAT)
L])
(ORR1
[NLAMBDA L
(EVAL (PICK0 L])
(TSTPARSE
[LAMBDA NIL
(USEREXEC
(QUOTE PAT?)
(APPEND
[QUOTE ([G (CAR (LISPXUNREAD (LIST (UNPATPARSE (PROG (STARDONE)
(PAT]
(STOP (RETFROM (QUOTE USEREXEC)))
(GP (CAR (LISPXUNREAD (LIST (PROG (STARDONE)
(PAT']
LISPXMACROS)
(QUOTE PARSEUSERFN])
(PARSEUSERFN
[LAMBDA (TOPPAT EXPR)
(COND
((LISTP TOPPAT)
(PRIN1 "Parses to:" T)
(PRINT (SETQ EXPR (PATPARSE (COPY TOPPAT)))
T)
(PRIN1 "Which unparses to:" T)
(PRINT (SETQ EXPR2 (UNPATPARSE EXPR))
T)
(TERPRI T)
(CPLISTS TOPPAT EXPR2)
(TERPRI T)
(CPLISTS EXPR (PATPARSE EXPR2))
(RPLACA LISPXHIST EXPR)
(RETFROM (QUOTE LISPX))
T])
(PICK0
[LAMBDA (L)
(CAR (NTH L (RAND 1 (LENGTH L])
(VOWEL
[LAMBDA NIL
(PICK0 (QUOTE (A E I O U OU])
(SUFFIX
[LAMBDA NIL
(PICK0 (QUOTE (B C D E F G H J K L M N P Q R S T V W X Z])
(PREFIX
[LAMBDA NIL
(PICK0 (QUOTE ("" B C D F G H J K L M N P Q R S T V W X Z])
(LMUSERFN
[LAMBDA (PAT EXPR)
(COND
((LISTP PAT)
(PROG ((FAULTFN (QUOTE TYPE-IN))
(TYPE-IN? T))
(OUTPUT T)
(LISPXPRINTDEF [SETQ EXPR (COND
(TIMEFLG (TIME (MAKEMATCH VARTOMATCH
PAT)))
(BRKDWNFLG (PROG1 (MAKEMATCH
VARTOMATCH PAT)
(RESULTS)))
(T (MAKEMATCH VARTOMATCH PAT]
1 T)
(LISPXTERPRI T)
(AND TIMEFLG (PROGN (LISPXPRIN1 (COUNT EXPR)
T)
(LISPXPRIN1 " words in expression
" T)))
(COND
((OPENP EXAMPLEFILE (QUOTE OUTPUT))
(OUTPUT EXAMPLEFILE)
(PRINT PAT)
(TERPRI)
(PRINTDEF EXPR)
(RPTQ 4 (TERPRI))
(OUTPUT T)))
(RPLACA LISPXHIST (QUOTE !))
(RETFROM (QUOTE LISPX))
T])
(TSTMATCH
[LAMBDA (EXPR FAULTFN TYPE-IN?) (* EXPR AND FAULTFN ARE
NEEDED BY CLISPLOOKUP)
(USEREXEC
(PACK (LIST VARTOMATCH (QUOTE ":")))
(APPEND
[QUOTE ([G (CAR (LISPXUNREAD (LIST (UNPATPARSE (PROG (STARDONE)
(PAT]
(STOP (RETFROM (QUOTE USEREXEC)))
(GP (CAR (LISPXUNREAD (LIST (PROG (STARDONE)
(PAT']
LISPXMACROS)
(QUOTE LMUSERFN])
(PACKRAT1
[LAMBDA (ATLST LST)
(COND
(ATLST (CONS (PACK ATLST)
LST))
(T LST])
(PACKRAT
[LAMBDA N
(PROG ((CNT N)
VAL ATLST)
LP (COND
((ZEROP CNT)
(RETURN (PACKRAT1 ATLST VAL)))
((LITATOM (ARG N CNT))
(SETQ ATLST (CONS (ARG N CNT)
ATLST)))
(T (SETQ VAL (CONS (ARG N CNT)
(PACKRAT1 ATLST VAL)))
(SETQ ATLST NIL)))
(SETQ CNT (SUB1 CNT))
(GO LP])
(UNPATPARSELT
[LAMBDA (PATELT) (* create valid input
sytax)
(PROG (TEM)
(COND
((LITATOM PATELT)
(SELECTQ PATELT
((& $ * -- NIL T)
(LIST PATELT))
(HELP (QUOTE "CAN'T UNPATPARSE")
PATELT)))
((LISTP PATELT)
(SELECTQ (CAR PATELT)
((= == ')
(PACKRAT (CAR PATELT)
(CDR PATELT)))
[* (COND
((EQ (CDR PATELT)
(QUOTE &))
(LIST (QUOTE *)))
(T (CONS (QUOTE *←)
(UNPATPARSELT (CDR PATELT]
[$PACKED$
(COND
((NLISTP (CDR PATELT))
(PACKRAT (QUOTE $)
(CDR PATELT)))
(T (HELP "UNPARSE: $PACKED$ LISTP" PATELT]
[≠ (LIST (PACK (CDR PATELT]
[≠≠ (LIST (PACKC (APPEND (CDDDR PATELT)
(QUOTE (27 27]
[SUBPAT (LIST (UNPATPARSE (CDR PATELT]
[@ (PACKRAT2 (APPEND (UNPATPARSELT (CDDR PATELT))
(COND
((NLISTP (CADR PATELT))
(LIST (QUOTE @)
(CADR PATELT)))
((EQ (CAADR PATELT)
(QUOTE }))
(LIST (QUOTE }@)
(CDADR PATELT)))
(T (HELP "UNPARSE"]
[(*ANY* *EVERY*)
(LIST (CONS (CAR PATELT)
(UNPATPARSE (CDR PATELT]
((← <-)
(NCONC [PACKRAT (CADR PATELT)
(QUOTE ←)
(CAR (SETQ TEM
(UNPATPARSELT
(CDDR PATELT]
(CDR TEM)))
[(-> →)
(PACKRAT2 (APPEND (UNPATPARSELT (CDDR PATELT))
(LIST (QUOTE ←)
(CADR PATELT]
((} !)
(NCONC [PACKRAT (QUOTE !)
(CAR (SETQ TEM
(UNPATPARSELT
(CDR PATELT]
(CDR TEM)))
(HELP "UNPARSE")))
((OR (STRINGP PATELT)
(NUMBERP PATELT))
(LIST PATELT))
(T (HELP "UNPARSE"])
(UNPATPARSE
[LAMBDA (PAT) (* Unpatparse each
pattern element and
NCONC values together)
(MAPCONC PAT (FUNCTION UNPATPARSELT])
(FNNAME
[LAMBDA NIL
(PICK (QUOTE (NUMBERP GETD EXPRP ATOM LITATOM STRINGP NNIL ZEROP
INFILEP LISTP NLISTP MINUSP SMALLP
EASYTORECOMPUTE])
(NUMBER
[LAMBDA NIL
(RAND 2 10])
(LISTOF
[NLAMBDA (EXPR MIN MAX)
(PROG (VAL (MIN (OR (EVAL MIN)
0))
(MAX (OR (EVAL MAX)
4)))
(RPTQ (IPLUS MIN (RAND1 (IDIFFERENCE MAX MIN)))
(SETQ VAL (CONS (EVAL EXPR)
VAL)))
(RETURN VAL])
(XLATE
[LAMBDA (N1 N2)
(ADD1 (FTIMES N2 (EXPT (FDIFFERENCE N1 .999999)
2])
(GENPAT
[LAMBDA (STARDONE)
(PROG (VAL)
(PRINTDEF (SETQ VAL (PAT)))
(TERPRI)
(RETURN VAL])
(VAR
[LAMBDA NIL
(PACK (LIST (PREFIX)
(VOWEL)
(SUFFIX])
(EXPRESSION
[LAMBDA (FLG)
(ORR (COND
(FLG NIL)
(T (VAR)))
(VAR)
(NUMBER)
(CONS (SETQ FLG (FNNAME))
(COND
((SUBRP FLG)
(LIST (EXPRESSION)))
((GETD FLG)
(FOR X FROM 1 UNTIL (NARGS FLG) COLLECT (EXPRESSION))
)
(T (LISTOF (EXPRESSION)
0 3])
(PATELT
[LAMBDA NIL
(ORR (ORR (QUOTE &)
(NUMBER)
(STRING)
NIL
(CONS (QUOTE =)
(EXPRESSION))
(CONS (QUOTE ==)
(EXPRESSION))
(CONS (QUOTE ')
(EXPRESSION)))
(ORR (QUOTE $)
(QUOTE --))
(CONS (QUOTE @)
(CONS (FNNAME)
(PATELT)))
(CONS (ORR (QUOTE *EVERY*)
(QUOTE *ANY*))
(PAT))
(ORR (CONS (ORR (QUOTE <-)
(QUOTE ←))
(CONS (VAR)
(PATELT)))
(CONS (ORR (QUOTE →)
(QUOTE ->))
(CONS (EXPRESSION)
(PATELT)))
(CONS (QUOTE *)
(PATELT)))
(CONS (QUOTE SUBPAT)
(PAT))
(CONS (QUOTE })
(PATELT))
(CONS (QUOTE !)
(PATELT))
(CONS (QUOTE $PACKED$)
(ORR (NUMBER)
(NUMBEREXPRESSION])
(PAT
[LAMBDA NIL
(LISTOF (PATELT)
1])
(ORR
[NLAMBDA X
(PROG (TEM)
[COND
((NULL STACK)
(RETURN (EVAL (PICK X]
(SETQ X (NTH X (OR (CAR STACK)
0)))
(COND
((EVERY (CDR STACK)
(QUOTE NULL))
(GO BUMP)))
LP (COND
((NULL X)
(RPLACA STACK NIL)
(ERROR!)))
[COND
((SETQ TEM (ERSET (CAR X)))
(RETURN (CAR TEM]
BUMP(SETQ X (CDR X))
(RPLACA STACK (ADD1 (OR (CAR STACK)
0)))
(GO LP])
(RAND1
[LAMBDA (N)
(XLATE (RAND 0.0 .999999)
N])
(PICK
[LAMBDA (L)
(CAR (NTH L (RAND1 (LENGTH L])
(LISTFILES
[LAMBDA (FILLST)
[COND
((NULL FILLST)
(SETQ FILLST NOTLISTEDFILES))
((NLISTP FILLST)
(SETQ FILLST (CONS FILLST]
(for FIL in FILLST
do (LISTFILE (OR (INFILEP FIL)
(ERROR "NO SUCH FILE TO LIST" FIL)))
(/DSUBST NIL FIL NOTLISTEDFILES))
(SETQ NOTLISTEDFILES (/DREMOVE NIL NOTLISTEDFILES))
FILLST])
(CGQ
[NLAMBDA (FN)
(COPY (GETD FN])
(SAVE
[LAMBDA NIL
(AND (NLISTP (SYSOUT (QUOTE LARRY.SYS)))
(DELFILE (QUOTE LARRY.SYS])
(LISTFILE
[LAMBDA (FIL LISTFILEHOST LISTFILELOGIN)
(BKSYSBUF (CONCAT "FTP
" [SETQ LISTFILEHOST (OR LISTFILEHOST HOST (SETQ HOST
(PROGN (PRIN1 "HOST? ")
(READ T]
"
LOG "
[OR LISTFILELOGIN (GETP LISTFILEHOST
(QUOTE LOGIN))
(PUT LISTFILEHOST (QUOTE LOGIN)
(PROGN (PRIN1 LISTFILEHOST T)
(PRIN1 " LOGIN? " T)
(READ T]
"
TE
SE " FIL "
≠DIS
QUI
QUI
"))
(KFORK (SUBSYS))
FIL])
(FIXCHRS
[LAMBDA (FLG)
(COND
[(NULL FLG)
(FOR CHR IN CLISPCHARS WHEN (NOT (FMEMB CHR NEWCLISPCHARS))
JOIN (FOR PROP IN (QUOTE (CLISPTYPE LISPFN CLISPCLASS
UNARYOP))
JOIN (AND (GETP CHR PROP)
(PROG1 (LIST (LIST CHR PROP (GETP CHR PROP)
))
(REMPROP CHR PROP]
(T (FOR UNDO IN FLG DO (PUT (CAR UNDO)
(CADR UNDO)
(CADDR UNDO])
(UC
[LAMBDA (X)
(NOT (EXPRP X])
(DWIMIFYX
[LAMBDA (TAIL PARENT SUBPARENT FORMSFLG ONEFLG FAULTFN)
(RESETFORM (FIXCHRS)
(RESETVAR CLISPCHARRAY NEWCLISPCHARRAY
(RESETVAR CLISPCHARS NEWCLISPCHARS
(DWIMIFY1B TAIL PARENT SUBPARENT FORMSFLG ONEFLG
FAULTFN])
(PPCL
[NLAMBDA X
(RESETVAR CLISPIFYPRETTYFLG T (APPLY (QUOTE PP)
X])
(VALIDPATELT
[LAMBDA (PAT)
(COND
((NLISTP PAT)
(NULL PAT))
[(NLISTP (CAR PAT))
(OR (NUMBERP (CAR PAT))
(STRINGP (CAR PAT))
(AND (LITATOM (CAR PAT))
(FMEMB (CAR PAT)
(QUOTE (& $ -- NIL T]
(T (FMEMB (CAR (CAR PAT))
(QUOTE (→ ! $PACKED$ ' * *GLITCH ->
<- = == @ SUBPAT ←])
)
(LISPXPRINT (QUOTE GENPATFNS)
T)
(RPAQQ GENPATFNS
(DIFF LISTOFPATTERNELTS PATTERNELT ELTPATELT' PATELT' PAT' DE
ERSET NUMBEREXPRESSION STRING PACKRAT2 ORR1 TSTPARSE
PARSEUSERFN PICK0 VOWEL SUFFIX PREFIX LMUSERFN TSTMATCH
PACKRAT1 PACKRAT UNPATPARSELT UNPATPARSE FNNAME NUMBER
LISTOF XLATE GENPAT VAR EXPRESSION PATELT PAT ORR RAND1
PICK LISTFILES CGQ SAVE LISTFILE FIXCHRS UC DWIMIFYX
PPCL VALIDPATELT))
(LISPXPRINT (QUOTE GENPATVARS)
T)
(RPAQQ GENPATVARS ((VARS CLMATCHFLG HOST VARTOMATCH (TIMEFLG)
(EXAMPLEFILE)
(BRKDWNFLG))
(PROP LOGIN SAIL)
(P (MOVD (QUOTE LISPXPRINT)
(QUOTE LISPXPRINTDEF)))
(PROP MACRO ORR LISTOF)
(P (CLISPDEC (QUOTE FAST)))
(ADVICE 'AND)
(P [ADDTOVAR LISPXMACROS (FUCK (RETFROM (QUOTE LISPX)))
(FTP (SUBSYS 'FTP))
(TELNET (SUBSYS 'TELNET))
(WHO (KFORK (SUBSYS (QUOTE LD]
(ADDTOVAR LISPXCOMS FUCK FTP TELNET))
USERMACROS))
(RPAQQ CLMATCHFLG NIL)
(RPAQQ HOST SAIL)
(RPAQQ VARTOMATCH var)
(RPAQ TIMEFLG)
(RPAQ EXAMPLEFILE)
(RPAQ BRKDWNFLG)
(DEFLIST(QUOTE(
(SAIL "PAT,LMM")
))(QUOTE LOGIN))
(MOVD (QUOTE LISPXPRINT)
(QUOTE LISPXPRINTDEF))
(DEFLIST(QUOTE(
[ORR
(L (PROG ((TEM 0))
(CONS (QUOTE SELECTQ)
(CONS (LIST (QUOTE RAND1)
(LENGTH L))
(NCONC [MAPCAR L (FUNCTION
(LAMBDA
(X)
(LIST (SETQ TEM
(ADD1 TEM))
X]
(QUOTE ((HELP]
[LISTOF
(L ([LAMBDA
(EXPR MIN MAX)
(LIST (QUOTE PROG)
(QUOTE (VAL))
(LIST (QUOTE RPTQ)
[COND [MIN (LIST (QUOTE IPLUS)
MIN
(LIST (QUOTE RAND1)
(LIST (QUOTE IDIFFERENCE)
(OR MAX 10)
MIN]
(T (LIST (QUOTE RAND1)
(OR MAX 10]
(LIST (QUOTE SETQ)
(QUOTE VAL)
(CONS (QUOTE CONS)
(CONS EXPR (QUOTE (VAL]
(CAR L)
(CADR L)
(CADDR L]
))(QUOTE MACRO))
(CLISPDEC (QUOTE FAST))
(DEFLIST(QUOTE(
['AND
(NIL (BEFORE NIL
(RETURN
(PROG ($$VAL I)
(SETQ I 1)
$$LP
[COND ((IGREATERP I N)
(RETURN (COND
((CDR $$VAL)
(CONS (QUOTE AND)
$$VAL))
(T (OR (CAR $$VAL)
T]
[SETQ $$VAL
(NCONC $$VAL
(COND
((EQ (ARG N I)
T)
NIL)
((EQ (CAR (ARG N I))
(QUOTE AND))
(CDR (ARG N I)))
(T (LIST (ARG N I]
(SETQ I (IPLUS I 1))
(GO $$LP]
))(QUOTE READVICE))
[ADDTOVAR LISPXMACROS (FUCK (RETFROM (QUOTE LISPX)))
(FTP (SUBSYS 'FTP))
(TELNET (SUBSYS 'TELNET))
(WHO (KFORK (SUBSYS (QUOTE LD]
(ADDTOVAR LISPXCOMS FUCK FTP TELNET)
[RPAQQ USERMACROS
((POI NIL XXXX OK)
(XXXX NIL (MOVE 2 TO B)
(1 SUBSTVAR)
(MOVE TO : BF GENSYML)
!0 ?)
[?= NIL (ORR [(E (FOR X IN (ARGLIST (## 1))
AS Y IN (## 2 UP)
DO
(PRIN1 X T)
(PRIN1 " = " T)
(PRINT Y T]
((E (QUOTE ?=?]
(!← NIL !0)
(EF NIL (ORR [(E (APPLY* (QUOTE EDITF)
(COND ((LISTP (## UP 1))
(## UP 1 1))
(T (## UP 1]
((E (QUOTE EF?]
STOP